perm filename BROWSE.STA[TIM,LSP]1 blob sn#702190 filedate 1983-02-23 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Benchmark to create and browse through an AI-like data base of units
C00010 00003	(fasload meter)(fasload browse)
C00016 ENDMK
C⊗;
;;; Benchmark to create and browse through an AI-like data base of units

;;; n is # of symbols
;;; m is maximum amount of stuff on the plist
;;; npats is the number of basic patterns on the unit
;;; ipats is the instantiated copies of the patterns

(declare (fixsw t))
(declare (fasload meter fas dsk (tim lsp)))
(declare (setq meter:meterp t))
(meter:begin browse)

(meter-funs ((cdr "CDRs")(rplacd "RPLACDs")(1- "1-'s")(= "='s")
  	     (intern "INTERNs")(gensym "GENSYMs")(null "NULLs")(car "CARs")
	     (- "-'s")
	     (putprop "PUTPROPs")(push "CONs" cons)(cons "CONS" cons))
(defun init (n m npats ipats)
       (let ((ipats (subst () () ipats)))
	    (do ((p ipats (cdr p)))
		((null (cdr p)) (rplacd p ipats)))
	    (do ((n n (1- n))
		 (i m (cond ((= i 0) m)
			    (t (1- i))))
		 (name (intern (gensym)) (intern (gensym)))
		 (a ()))
		((= n 0) a)
		(push name a)
        	(do ((i i (1- i)))
		    ((= i 0))
           	     (putprop name() (gensym)))
            	(putprop
		 name
		 (do ((i npats (1- i))
		      (ipats ipats (cdr ipats))
		      (a ()))
		     ((= i 0) a)
		     (push (car ipats) a))
		 'pattern)
		(do ((j (- m i) (1- j)))
		    ((= j 0))
           	    (putprop name () (gensym)))))))  

(defmacro mod (x n) `(remainder ,x ,n))

(declare (special rand)(fixnum rand))
(setq rand 21.)

(defun seed () (setq rand 21.))

(meter-funs ((mod "MODs")(* "*'s"))
(defun random () (setq rand (mod (* rand 17.) 251.))))

(meter-funs ((cdr "CDRs")(rplacd "RPLACDs")(1- "1-'s")(= "='s")
	     (mod "MODs")(random "RANDOMs")(length "LENGTHs")
  	     (intern "INTERNs")(gensym "GENSYMs")(null "NULLs")(car "CARs")
	     (cddr "CDRs" CDR 2)
	     (putprop "PUTPROPs")(push "CONs" cons)(cons "CONS" cons))
(defun randomize (l)
       (do ((a ()))
	   ((null l) a)
	   (let ((n (mod (random) (length l))))
		(cond ((= n 0)
		       (push (car l) a)
		       (setq l (cdr l)))
		      (t 
		       (do ((n n (1- n))
			    (x l (cdr x)))
			   ((= n 1)
			    (push (car (cdr x)) a)
			    (rpl`βd x (cddr x))))))))))

(defmacro char1 (x) `(getchar ,x 1))

(meter-funs ((cdr "CDRs")(rplacd "RPLACDs")(1- "1-'s")(= "='s")
	     (mod "MODs")(random "RANDOMs")(length "LENGTHs")
  	     (intern "INTERNs")(gensym "GENSYMs")(null "NULLs")(car "CARs")
	     (cddr "CDRs" CDR 2)(eq "EQ's")(atom "ATOMs")(char1 "CHAR1's")
	     (assq "ASSQs")(append "APPENDs")(nconc "NCONCs")
	     (putprop "PUTPROPs")(push "CONs" cons)(cons "CONS" cons))
(defun match (pat dat alist)
       (cond ((null pat)
	      (null dat))
	     ((null dat) ())
	     ((or (eq (car pat) '?)
		  (eq (car pat)
		      (car dat)))
	      (match (cdr pat) (cdr dat) alist))
	     ((eq (car pat) '*)
	      (or (match (cdr pat) dat alist)
		  (match (cdr pat) (cdr dat) alist)
		  (match pat (cdr dat) alist)))
	     (t (cond ((atom (car pat))
		       (cond ((eq (char1 (car pat)) '?)
			      (let ((val (assq (car pat) alist)))
				   (cond (val (match (cons (cdr val)
							   (cdr pat))
						     dat alist))
					 (t (match (cdr pat)
						   (cdr dat)
						   (cons (cons (car pat)
							       (car dat))
							 alist))))))
			     ((eq (char1 (car pat)) '*)
			      (let ((val (assq (car pat) alist)))
				   (cond (val (match (append (cdr val)
							     (cdr pat))
						     dat alist))
					 (t 
					  (do ((l () (nconc l (ncons (car d))))
					       (e (cons () dat) (cdr e))
					       (d dat (cdr d)))
					      ((null e) ())
					      (cond ((match (cdr pat) d
							    (cons (cons (car pat) l)
								  alist))
						     (return t))))))))))
		      (t (and 
			  (not (atom (car dat)))
			  (match (car pat)
				 (car dat) alist)
			  (match (cdr pat)
				 (cdr dat) alist))))))))

(defun browse ()
       (seed)
       (investigate (randomize 
		     (init 100. 10. 4. '((a a a b b b b a a a a a b b a a a)
					 (a a b b b b a a
					    (a a)(b b))
					 (a a a b (b a) b a b a))))
		    '((*a ?b *b ?b a *a a *b *a)
		      (*a *b *b *a (*a) (*b))
		      (? ? * (b a) * ? ?))))

(meter-funs ((null "NULLs")(cdr "CDRs")(car "CARs")(match "MATCHs")
	     (get "GETs"))
(defun investigate (units pats)
       (do ((units units (cdr units)))
	   ((null units))
	   (do ((pats pats (cdr pats)))
	       ((null pats))
	       (do ((p (get (car units) 'pattern)
		       (cdr p)))
		   ((null p))
		   (match (car pats) (car p) ()))))))

(meter:end)
(include "timer.lsp")
(timer timit
       (browse))
       
(fasload meter)(fasload browse)
(timit)

Timing performed on Wednesday 02/23/83 at 14:52:59.
;BKPT ↑B
(meter:report)
Statistics
= <calls> (<percentage>) [runtime (<percentage>)]

Meter for: INIT
1 = 405 (5.62%) [0.014 (0.49%)]
2 = 3 (0.04%) [1.0E-3 (0.03%)]
3 = 1 (0.01%) [0.0 (0.0%)]
4 = 1591 (22.09%) [0.062 (2.17%)]
5 = 1901 (26.39%) [0.067 (2.34%)]
6 = 101 (1.4%) [0.055 (1.92%)]
7 = 1101 (15.29%) [1.114 (38.94%)]
8 = 500 (6.94%) [0.063 (2.2%)]
9 = 1100 (15.27%) [1.463 (51.14%)]
10 = 400 (5.55%) [0.016 (0.56%)]
11 = 100 (1.39%) [6.0E-3 (0.21%)]
Total = 7203	2.861

Meter for: RANDOM
1 = 100 (50.0%) [0.014 (73.68%)]
2 = 100 (50.0%) [5.0E-3 (26.32%)]
Total = 200	0.019

Meter for: RANDOMIZE
1 = 101 (1.23%) [6.0E-3 (1.36%)]
2 = 100 (1.22%) [0.064 (14.48%)]
3 = 100 (1.22%) [0.024 (5.43%)]
4 = 100 (1.22%) [0.03 (6.79%)]
5 = 2573 (31.3%) [0.093 (21.04%)]
6 = 100 (1.22%) [0.025 (5.66%)]
7 = 100 (1.22%) [0.013 (2.94%)]
8 = 2573 (31.3%) [0.092 (20.81%)]
9 = 2375 (28.89%) [0.082 (18.55%)]
10 = 98 (1.19%) [0.013 (2.94%)]
Total = 8220	0.442

Meter for: MATCH
1 = 61688 (13.25%) [1.912 (3.8%)]
2 = 92425 (19.85%) [17.209 (34.18%)]
3 = 161527 (34.7%) [5.644 (11.21%)]
4 = 59164 (12.71%) [2.059 (4.09%)]
5 = 17688 (3.8%) [2.136 (4.24%)]
6 = 27712 (5.95%) [5.691 (11.3%)]
7 = 9743 (2.09%) [1.392 (2.76%)]
8 = 20986 (4.51%) [8.795 (17.47%)]
9 = 6165 (1.32%) [3.153 (6.26%)]
10 = 8454 (1.82%) [2.359 (4.69%)]
Total = 465552	50.35

Meter for: INVESTIGATE
1 = 195 (20.35%) [4.0E-3 (0.01%)]
2 = 246 (25.68%) [4.0E-3 (0.01%)]
3 = 37 (3.86%) [9.0E-3 (0.02%)]
4 = 333 (34.76%) [0.012 (0.02%)]
5 = 147 (15.34%) [49.684 (99.94%)]
Total = 958	49.713